Visual Basic Controls

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / cpkocx17 / briscola.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1998-07-17 | 32.7 KB | 1,014 lines

VERSION 4.00 Begin VB.Form Game Appearance = 0 'Flat BackColor = &H00808000& Caption = "Briscola" ClientHeight = 6930 ClientLeft = 1020 ClientTop = 1875 ClientWidth = 7815 ClipControls = 0 'False FillColor = &H00C0C0C0& FillStyle = 0 'Solid BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 8.25 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H00C0C0C0& Height = 7620 HelpContextID = 110 Icon = "BRISCOLA.frx":0000 KeyPreview = -1 'True Left = 960 LinkMode = 1 'Source LinkTopic = "game" MaxButton = 0 'False ScaleHeight = 6930 ScaleWidth = 7815 Top = 1245 Width = 7935 Begin VB.PictureBox StatusLine Align = 2 'Align Bottom Height = 450 Left = 0 ScaleHeight = 390 ScaleWidth = 7755 TabIndex = 0 Top = 6480 Width = 7815 Begin VB.Label Score Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Score" Height = 285 Left = 5640 TabIndex = 3 Top = 60 Width = 2085 End Begin VB.Label MessageView Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "MessageView" Height = 285 Left = 1545 TabIndex = 2 Top = 60 Width = 4005 End Begin VB.Label Mode Alignment = 2 'Center BorderStyle = 1 'Fixed Single Caption = "Mode" Height = 285 Left = 60 TabIndex = 1 Top = 60 Width = 1455 End End Begin VB.PictureBox ToolBar Align = 1 'Align Top ForeColor = &H80000008& Height = 495 Left = 0 ScaleHeight = 435 ScaleWidth = 7755 TabIndex = 4 Top = 0 Width = 7815 Begin VB.CommandButton ToolButton Caption = "Pause" Height = 255 Index = 1 Left = 2100 TabIndex = 22 Tag = "Pause Game" Top = 120 Width = 915 End Begin VB.CommandButton ToolButton Caption = "Stop" Height = 255 Index = 2 Left = 3000 TabIndex = 11 Tag = "Stop game in progress" Top = 120 Width = 615 End Begin VB.CommandButton ToolButton Caption = "Hint" Height = 255 Index = 5 Left = 4020 TabIndex = 8 Tag = "Suggest Card" Top = 120 Width = 615 End Begin VB.CommandButton ToolButton Caption = "Save" Height = 255 Index = 4 Left = 720 TabIndex = 7 Tag = "Save this Game" Top = 120 Width = 615 End Begin VB.CommandButton ToolButton Caption = "Open" Height = 255 Index = 3 Left = 120 TabIndex = 6 Tag = "Open a Saved Game" Top = 120 Width = 615 End Begin VB.CommandButton ToolButton Caption = "Start" Height = 255 Index = 0 Left = 1500 TabIndex = 5 Tag = "Start a New Game" Top = 120 Width = 615 End End Begin VB.PictureBox Table Appearance = 0 'Flat BackColor = &H00808000& ForeColor = &H80000008& Height = 6015 Left = 0 ScaleHeight = 399 ScaleMode = 3 'Pixel ScaleWidth = 519 TabIndex = 9 Top = 480 Width = 7815 Begin VB.Timer GameTimer Enabled = 0 'False Interval = 3000 Left = 2460 Top = 900 End Begin Cardpk.Cardpack DragCards Height = 1440 Left = 2580 TabIndex = 23 Top = 1800 Visible = 0 'False Width = 1065 _version = 65536 _extentx = 1879 _extenty = 2540 _stockprops = 65 cardslibrary = "cards.dll" numcards = 0 stackfacing = 1 End Begin MSComDlg.CommonDialog DialogObj Left = 2400 Top = 360 _version = 65536 _extentx = 847 _extenty = 847 _stockprops = 0 flags = 20 helpcommand = 1 helpcontext = 500 End Begin Cardpk.Cardpack Deck Height = 1740 Left = 5700 TabIndex = 15 Top = 1860 Width = 1365 _version = 65536 _extentx = 2408 _extenty = 3069 _stockprops = 65 cardslibrary = "cards.dll" autosize = 0 'False spreadstyle = 1 spreaddir = 4 drawstephoriz = 1 drawstepvert = -1 drawcardevery = 2 drawstarty = 20 End Begin Cardpk.Cardpack Player1 Height = 1440 Left = 120 TabIndex = 16 Top = 4080 Width = 2115 _version = 65536 _extentx = 3731 _extenty = 2540 _stockprops = 65 cardslibrary = "cards.dll" spreadstyle = 3 spreaddir = 2 drawstephoriz = 35 packonremove = 0 'False numcards = 3 stackfacing = 1 End Begin Cardpk.Cardpack Player2 Height = 1440 Left = 60 TabIndex = 17 Top = 180 Width = 2115 _version = 65536 _extentx = 3731 _extenty = 2540 _stockprops = 65 cardslibrary = "cards.dll" spreadstyle = 3 spreaddir = 2 drawstephoriz = 35 packonremove = 0 'False numcards = 3 End Begin Cardpk.Cardpack OnTable Height = 1440 Left = 180 TabIndex = 18 Top = 2160 Width = 2145 _version = 65536 _extentx = 3784 _extenty = 2540 _stockprops = 65 cardslibrary = "cards.dll" spreadstyle = 4 spreaddir = 2 drawstephoriz = 72 numcards = 2 stackfacing = 1 End Begin Cardpk.Cardpack Briscola Height = 1440 Left = 4620 TabIndex = 19 Top = 2160 Width = 1065 _version = 65536 _extentx = 1879 _extenty = 2540 _stockprops = 65 cardslibrary = "cards.dll" numcards = 0 stackfacing = 1 End Begin Cardpk.Cardpack Stack2 Height = 1440 Left = 3780 TabIndex = 20 Top = 180 Width = 1065 _version = 65536 _extentx = 1879 _extenty = 2540 _stockprops = 65 cardslibrary = "cards.dll" spreadstyle = 1 spreaddir = 4 drawstephoriz = 1 drawstepvert = -1 drawcardevery = 2 numcards = 0 End Begin Cardpk.Cardpack Stack1 Height = 1440 Left = 3900 TabIndex = 21 Top = 4080 Width = 1065 _version = 65536 _extentx = 1879 _extenty = 2540 _stockprops = 65 cardslibrary = "cards.dll" spreadstyle = 1 spreaddir = 4 drawstephoriz = 1 drawstepvert = -1 drawcardevery = 2 numcards = 0 End Begin VB.Label Player2Name Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Computer" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 285 Left = 5220 TabIndex = 10 Top = 60 Width = 1605 End Begin VB.Label Score2 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Score2" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 285 Left = 6900 TabIndex = 13 Top = 60 Width = 795 End Begin VB.Shape Shape1 BackColor = &H00008000& BackStyle = 1 'Opaque Height = 375 Index = 0 Left = 5100 Top = 60 Width = 2655 End Begin VB.Label Score1 Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Score1" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 285 Left = 6900 TabIndex = 14 Top = 5640 Width = 795 End Begin VB.Label Player1Name Appearance = 0 'Flat BackColor = &H80000005& BackStyle = 0 'Transparent Caption = "Player" BeginProperty Font name = "MS Sans Serif" charset = 1 weight = 700 size = 12 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty ForeColor = &H80000008& Height = 285 Left = 5220 TabIndex = 12 Top = 5640 Width = 1605 End Begin VB.Shape Shape1 BackColor = &H00008000& BackStyle = 1 'Opaque Height = 375 Index = 1 Left = 5100 Top = 5580 Width = 2655 End End Begin VB.Menu FileMenu Caption = "&Game" HelpContextID = 102 Begin VB.Menu FileNew Caption = "&New Game F2" End Begin VB.Menu FilePause Caption = "&Pause Game F3" End Begin VB.Menu FileStop Caption = "&Stop Game F12" End Begin VB.Menu FileHint Caption = "Give &Hint F11" End Begin VB.Menu msep4 Caption = "-" End Begin VB.Menu FileOpen Caption = "&Open... F4" End Begin VB.Menu FileSave Caption = "Sa&ve F5" End Begin VB.Menu FileSaveAs Caption = "Sav&e As... F6" End Begin VB.Menu FileRecent Caption = "-" Index = 0 Visible = 0 'False End Begin VB.Menu FileRecent Caption = "" Index = 1 Visible = 0 'False End Begin VB.Menu FileRecent Caption = "" Index = 2 Visible = 0 'False End Begin VB.Menu FileRecent Caption = "" Index = 3 Visible = 0 'False End Begin VB.Menu FileRecent Caption = "" Index = 4 Visible = 0 'False End Begin VB.Menu FileRecent Caption = "" Index = 5 Visible = 0 'False End Begin VB.Menu MenuSep2 Caption = "-" End Begin VB.Menu FileExit Caption = "E&xit" End End Begin VB.Menu MenuSettings Caption = "&Options" Begin VB.Menu OptToolBar Caption = "Show &Tool Bar" Checked = -1 'True End Begin VB.Menu OptStatusBar Caption = "Show &Status Bar" Checked = -1 'True End Begin VB.Menu OptSound Caption = "Sound &Effects" End Begin VB.Menu OptAnimate Caption = "Card &Animations" Visible = 0 'False End Begin VB.Menu OptTrace Caption = "&Debug Window" End Begin VB.Menu OptPeek Caption = "&Peek Cards" End Begin VB.Menu mSep1 Caption = "-" End Begin VB.Menu mGameOptions Caption = "Game Options" End End Begin VB.Menu MenuHelp Caption = "&Help" HelpContextID = 501 Begin VB.Menu HelpContents Caption = "&Contents" End Begin VB.Menu HelpUsingHelp Caption = "&Using Help" End Begin VB.Menu MenuSep3 Caption = "-" End Begin VB.Menu HelpAbout Caption = "&About..." End End Attribute VB_Name = "Game" Attribute VB_Creatable = False Attribute VB_Exposed = False ' Constants and declarations. Const BRISCOLA_HELP_TUTOR = 110 ' Toolbar Buttons Const BTN_START = 0 Const BTN_PAUSE = 1 Const BTN_STOP = 2 Const BTN_FILEOPEN = 3 Const BTN_FILESAVE = 4 Const BTN_HINT = 5 Const BTN_HELPCONTEXT = 10 Const BTN_HELPCONTENTS = 11 Sub ModePause() FileNew.Enabled = True FileOpen.Enabled = True FileSave.Enabled = True FileSaveAs.Enabled = True FilePause.Enabled = True FilePause.Checked = True FileStop.Enabled = True ToolButton(BTN_START).Enabled = True ToolButton(BTN_PAUSE).Enabled = True ToolButton(BTN_STOP).Enabled = True ToolButton(BTN_FILEOPEN).Enabled = True ToolButton(BTN_FILESAVE).Enabled = True ToolButton(BTN_HINT).Enabled = False End Sub Sub ModeRun() FileNew.Enabled = 0 FileOpen.Enabled = 0 FileSave.Enabled = 0 FileSaveAs.Enabled = 0 FilePause.Enabled = True FilePause.Checked = False FileStop.Enabled = True FileHint.Enabled = (Game_Mode <> MODE_DEMO) ToolButton(BTN_START).Enabled = False ToolButton(BTN_PAUSE).Enabled = True ToolButton(BTN_STOP).Enabled = True ToolButton(BTN_FILEOPEN).Enabled = False ToolButton(BTN_FILESAVE).Enabled = False ToolButton(BTN_HINT).Enabled = (Game_Mode <> MODE_DEMO) Game.Player1Name = Player1_Name & ": " Game.Player2Name = Player2_Name & ": " End Sub Sub ModeStop() FileNew.Enabled = True FileOpen.Enabled = True FileSave.Enabled = True FileSaveAs.Enabled = True FilePause.Enabled = False FilePause.Checked = False FileStop.Enabled = False ToolButton(BTN_START).Enabled = True ToolButton(BTN_FILEOPEN).Enabled = True ToolButton(BTN_FILESAVE).Enabled = True ToolButton(BTN_PAUSE).Enabled = False ToolButton(BTN_STOP).Enabled = False ToolButton(BTN_HINT).Enabled = False End Sub Sub MoveCard(cFrom As Cardpack, idx%, cTo As Cardpack) Dim steps%, i%, c% Dim dx%, dy% Dim tx%, ty% Dim cx%, cy% Const ANIM_SPEED = 10 ' In VB5 .Move does not work very well. Disable it. #If Win32 Then cTo.TopCard = cFrom.RemoveCard(idx%) DragCards.Visible = False DoEvents Sleep 0.1 Exit Sub #End If ' calc coordinates of source and target position cx% = cFrom.Left + cFrom.DrawStartX + idx% * cFrom.DrawStepHoriz cy% = cFrom.Top + cFrom.DrawStartY + idx% * cFrom.DrawStepVert tx% = cTo.Left + cTo.DrawStartX + cTo.NumCards * cTo.DrawStepHoriz ty% = cTo.Top + cTo.DrawStartY + cTo.NumCards * cTo.DrawStepVert ' calc # of steps as max distance \ speed dx% = Abs(tx% - cx%) dy% = Abs(ty% - cy%) If dx% > dy% Then steps% = dx% Else steps% = dy% steps% = steps% \ ANIM_SPEED ' pick card and move it to the "dragging" control DragCards.NumCards = 0 DragCards.TopCard = cFrom.Card(idx%) DragCards.ZOrder ' in VB4/16 once ain't enough the 1st time DragCards.ZOrder DragCards.StackFacing = cFrom.StackFacing DragCards.Move cx%, cy% DragCards.Visible = True c% = cFrom.RemoveCard(idx%) For i% = 0 To steps% dx% = (tx% - cx%) \ (steps% - i% + 1) dy% = (ty% - cy%) \ (steps% - i% + 1) cx% = cx% + dx% cy% = cy% + dy% DragCards.Move cx%, cy% Next DragCards.StackFacing = cTo.StackFacing cTo.TopCard = DragCards.Card(0) DragCards.Visible = False DoEvents Sleep 0.1 End Sub Private Sub Briscola_Change() ' record suit for faster access, remembers it ' even when the briscola has been picked up. If Briscola.NumCards > 0 Then Game_BriscolaSuit = Briscola.Suit(0) End If End Sub ' trace what is happening on the table in terms of ' game logic, for debugging purposes. Private Sub OnTable_Trace(order%) Dim pl%, p$, s$ If Not App_Debug Then Exit Sub Trace "OnTable_Change " & order% & " cards, was " & OnTable.Tag pl% = Hand_PlayerTurn If pl% = 0 Then pl% = 2 p$ = Game_PlayerName(Hand_PlayerTurn) Select Case order% Case 0 ' not interesting Case 1 ' just removing cards, still not interesting If Val(OnTable.Tag) = 2 Then Exit Sub ' a card was added, this is interesting s$ = "--> Hand " & Hand_Number & " - Player " & pl% & " (" & p$ & ")" s$ = s$ & " - Briscola: " & CardName$(Briscola.Card(0)) Trace s$ Case 2 ' both cards player, this is the outcome of hand s$ = "--> Hand " & Hand_Number & " - Player " & pl% & " (" & p$ & ")" s$ = s$ & " - Briscola: " & CardName$(Briscola.Card(0)) Trace s$ s$ = "--> C1=" & CardName$(Hand_CardPlayer1) & ", C2=" & CardName$(Hand_CardPlayer2) s = s$ & " - Winner is " & Hand_Winner Trace s$ End Select End Sub Private Sub FileExit_Click() If Game_AllowAbort() Then Unload Me End If End Sub Private Sub FileHint_Click() Game_GiveHint End Sub Private Sub FileNew_Click() Game_New End Sub Private Sub FileOpen_Click() Dim fn$ On Error GoTo cancel_load If Game_AllowAbort() Then DialogObj.DialogTitle = "Open " & App_FileType$ DialogObj.DefaultExt = App_FileExt$ DialogObj.Flags = (OFN_HIDEREADONLY Or OFN_SHOWHELP) If Game_FileName$ <> Game_NoFileName$ Then DialogObj.FileName = Game_FileName$ Else DialogObj.FileName = "" End If DialogObj.Filter = App_FileType$ & "|*." & App_FileExt$ & "|All Files|*.*" DialogObj.CancelError = True DialogObj.Action = CD_OPENFILE fn$ = DialogObj.FileName If fn$ <> "" Then Table_Disable "Opening '" & FilePart$(fn$) & "'..." Game_Open fn$ RecentFile_AddItem Game, Game_FileName$ Table_Enable End If End If cancel_load: Exit Sub End Sub Private Sub FilePause_Click() FilePause.Checked = Not FilePause.Checked Game_Pause FilePause.Checked If FilePause.Checked Then ToolButton(BTN_PAUSE).Caption = "Resume" Else ToolButton(BTN_PAUSE).Caption = "Pause" End If End Sub Private Sub FileRecent_Click(Index As Integer) Dim fn$ fn$ = RecentFile_Item$(Game, Index) If Game_AllowAbort() Then Table_Disable "Opening '" & FilePart$(fn$) & "'..." Game_Open fn$ Table_Enable End If End Sub Private Sub FileSave_Click() If Game_FileName$ = "Unnamed" Then FileSaveAs_Click Else Table_Disable "Saving '" & FilePart$(Game_FileName$) & "'..." Game_Save Game_FileName$ Table_Enable End If End Sub Private Sub FileSaveAs_Click() Dim fn$ On Error GoTo cancel_save DialogObj.DialogTitle = "Open " & App_FileType$ DialogObj.DefaultExt = App_FileExt$ DialogObj.FileName = Game_FileName$ DialogObj.Filter = App_FileType$ & "|*." & App_FileExt$ & "|All Files|*.*" DialogObj.CancelError = True DialogObj.Flags = (OFN_HIDEREADONLY Or OFN_SHOWHELP) retry: DialogObj.Action = CD_SAVEFILE fn$ = DialogObj.FileName If fn$ <> "" Then DoSave = True If FileExists(fn$) = True Then Select Case AskOverWrite(fn$) Case IDNO GoTo retry Case IDCANCEL DoSave = False End Select End If If DoSave = True Then Table_Disable "Saving as '" & FilePart$(fn$) & "'..." Game_Save fn$ RecentFile_AddItem Game, Game_FileName$ Table_Enable End If End If cancel_save: Exit Sub End Sub Private Sub FileStop_Click() Game_Finish True End Sub Private Sub Form_KeyPress(KeyAscii As Integer) ' ESC can be used to quit a Demo If KeyAscii = 27 Then If Game_Mode = MODE_DEMO Then Game_ModeNormal End If End If End Sub Private Sub Layout() Dim h As Long, bdr_h As Integer, bdr_w As Integer Static laying_out As Integer ' avoid recursion If laying_out = True Then Exit Sub laying_out = True ' avoid recursion h = 0 bdr_h = Game.Height - Game.ScaleHeight ' border sizes bdr_w = Game.Width - Game.ScaleWidth ' border sizes If ToolBar.Visible Then h = h + ToolBar.Height End If Table.Top = h h = h + Table.Height If StatusLine.Visible Then h = h + StatusLine.Height End If ' can resize only if not minimized or maximized If Me.WindowState = 0 Then Game.Height = h + bdr_h Table.Width = Game.ScaleWidth laying_out = False End Sub Private Sub Form_LinkClose() MsgBox Game.Player2Name & " disconnected" Game_Disconnect Game_ModeNormal End Sub Private Sub Form_LinkError(LinkErr As Integer) MsgBox Game.Player2Name & " disconnected" Game_Disconnect Game_ModeNormal End Sub ' Invoked by partner with: ' CmdStr = RemoteHost + "," + RemotePlayerName Private Sub Form_LinkExecute(CmdStr As String, Cancel As Integer) Dim s$, r%, Cmd$ If App_Debug Then Trace "LinkExecute " & CmdStr Cmd$ = Left$(CmdStr, 1) Select Case Cmd$ Case "C" ' connect Game_Accept Mid$(CmdStr, 1), Cancel Case "R" ' restart Game_Start Case Else MsgBox "Invalid Network Command" End Select End Sub Private Sub Form_Load() Layout Table_Clear Form_SetTitle Me Form_Center Me Game_SetDefaults Game_Listen End Sub Private Sub Form_Resize() Layout End Sub Private Sub Form_Unload(Cancel As Integer) App_Close Game End End Sub Private Sub GameTimer_Timer() ' prevent recursion in case someone yields GameTimer.Enabled = False If App_Debug Then Trace "Game_Timer" ' Still need to connect back over network? If Game_Mode = MODE_NETWORK And Player1.LinkMode = 0 Then Game_ConnectBack Exit Sub End If ' Normal Play. Don't play if minimized If Game_InProgress And Not WindowStatus = 1 Then ' players finished a hand If Game.OnTable.NumCards = 2 Then Hand_Next ' check if we have to play some side Else Game_AutoPlay End If End If ' reschedule ourselves GameTimer.Enabled = True End Sub Private Sub HelpAbout_Click() AboutForm.Show End Sub Private Sub HelpContents_Click() Help_Conts End Sub Private Sub HelpUsingHelp_Click() Help_UsingHelp End Sub Private Sub OptAnimate_Click() OptAnimate.Checked = Not OptAnimate.Checked End Sub Private Sub mGameOptions_Click() Game_Options End Sub ' Note Well: ' The game may be linked over DDE to another one ' For this reason, game state transition must be ' triggered by changed in this control, NOT by ' explicit calls when dealing or playing cards! Private Sub OnTable_Change() If Not Game_InProgress Then Exit Sub If App_Debug Then Trace "OnTable_Change" Select Case OnTable.NumCards Case 0 ' deck was cleared, allow players to play Hand_Clear Case 1 ' Check that we are ADDING cards, not removing ' if so, previous # of card was 0. Switch sides If Val(OnTable.Tag) = 0 Then Hand_SwitchPlayer End If Case 2 Hand_CheckWinner End Select If App_Debug Then OnTable_Trace OnTable.NumCards ' stash current # of cards, so next time we know what happened OnTable.Tag = OnTable.NumCards End Sub Private Sub OptPeek_Click() OptPeek.Checked = Not OptPeek.Checked If OptPeek.Checked Then Player2.StackFacing = CARDS_FACING_UP Else Player2.StackFacing = CARDS_FACING_DOWN End If End Sub Private Sub OptSound_Click() OptSound.Checked = Not OptSound.Checked End Sub Private Sub OptStatusBar_Click() OptStatusBar.Checked = Not OptStatusBar.Checked StatusLine.Visible = OptStatusBar.Checked Layout End Sub Private Sub OptToolBar_Click() OptToolBar.Checked = Not OptToolBar.Checked ToolBar.Visible = OptToolBar.Checked Layout End Sub Private Sub OptTrace_Click() OptTrace.Checked = Not OptTrace.Checked TraceMode (OptTrace.Checked) End Sub Private Sub Player1_Change() If App_Debug Then Trace "Player1_Change: " & Player1.Count(0) & " cards" End Sub Private Sub Player1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If Player1_AutoPlay Then Exit Sub If Player1.Current <> CARD_NONE Then Player1.Selected(Player1.Current) = True End Sub Private Sub Player1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) If Player1_AutoPlay Then Exit Sub If Player1.Current <> CARD_NONE Then Player1.Selected(Player1.Current) = False If Hand_CanPlay(1) And Player1.Current <> CARD_NONE Then Hand_PlayCard Player1, Player1.Current End If End Sub Private Sub Player2_Change() If App_Debug Then Trace "Player 2 Changed: " & Player2.Count(0) End Sub Private Sub Player2_Click() If Not Game_InProgress Then Exit Sub If Not OptPeek.Checked Then Game.MessageView = Game_PlayerName(1) & NOT_YOUR_CARDS End If End Sub Private Sub Stack1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If OptPeek.Checked Then Stack1.SpreadStyle = CARDS_SPREAD_TIGHT Stack1.SpreadDir = CARDS_SPREAD_RIGHT Stack1.Action = CARDS_ACTION_TURN_UP End If End Sub Private Sub Stack1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Stack1.SpreadStyle = CARDS_SPREAD_SLANTED Stack1.SpreadDir = CARDS_SPREAD_UP_RIGHT Stack1.Action = CARDS_ACTION_TURN_DOWN End Sub Private Sub Stack2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) If OptPeek.Checked Then Stack2.SpreadStyle = CARDS_SPREAD_TIGHT Stack2.SpreadDir = CARDS_SPREAD_RIGHT Stack2.Action = CARDS_ACTION_TURN_UP End If End Sub Private Sub Stack2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Stack2.SpreadStyle = CARDS_SPREAD_SLANTED Stack2.SpreadDir = CARDS_SPREAD_UP_RIGHT Stack2.Action = CARDS_ACTION_TURN_DOWN End Sub Private Sub ToolButton_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) ' Display help message associated with this button Game_Msg (ToolButton(Index).Tag) End Sub Private Sub ToolButton_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) ' Clear the help message Game_Msg "" ' Do not trigger command if mouse is release outside button If x < 0 Or y < 0 Or x > ToolButton(Index).Width Or y > ToolButton(Index).Height Then Exit Sub Select Case Index Case BTN_START FileNew_Click Case BTN_PAUSE FilePause_Click Case BTN_STOP FileStop_Click Case BTN_FILEOPEN FileOpen_Click Case BTN_FILESAVE FileSave_Click Case BTN_HINT Game_GiveHint End Select End Sub